home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / runcon.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  65KB  |  2,168 lines
  1. /* runcon.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer maxtim, itime, icost;
  26. } cje_;
  27.  
  28. #define cje_1 cje_
  29.  
  30. struct {
  31.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  32.         rstats[50];
  33.     integer iwidth, lwidth, nopage;
  34. } miscel_;
  35.  
  36. #define miscel_1 miscel_
  37.  
  38. struct {
  39.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  40.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  41. } cirdat_;
  42.  
  43. #define cirdat_1 cirdat_
  44.  
  45. struct {
  46.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  47.         sfactr;
  48.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  49.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  50. } status_;
  51.  
  52. #define status_1 status_
  53.  
  54. struct {
  55.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  56.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  57. } flags_;
  58.  
  59. #define flags_1 flags_
  60.  
  61. struct {
  62.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  63.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  64.          pivrel;
  65. } knstnt_;
  66.  
  67. #define knstnt_1 knstnt_
  68.  
  69. struct {
  70.     doublereal tcstar[2], tcstop[2], tcincr[2];
  71.     integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
  72. } dc_;
  73.  
  74. #define dc_1 dc_
  75.  
  76. struct {
  77.     doublereal fstart, fstop, fincr, skw2, refprl, spw2;
  78.     integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
  79. } ac_;
  80.  
  81. #define ac_1 ac_
  82.  
  83. struct {
  84.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  85.     integer jtrflg;
  86. } tran_;
  87.  
  88. #define tran_1 tran_
  89.  
  90. struct {
  91.     doublereal xincr, string[15], xstart, yvar[8];
  92.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  93. } outinf_;
  94.  
  95. #define outinf_1 outinf_
  96.  
  97. struct {
  98.     integer idebug[20];
  99. } debug_;
  100.  
  101. #define debug_1 debug_
  102.  
  103. struct {
  104.     doublereal value[200000];
  105. } blank_;
  106.  
  107. #define blank_1 blank_
  108.  
  109. /* Table of constant values */
  110.  
  111. static integer c__2 = 2;
  112. static integer c__1 = 1;
  113. static integer c__7 = 7;
  114. static integer c__0 = 0;
  115. static integer c__5 = 5;
  116. static integer c__4 = 4;
  117. static integer c__3 = 3;
  118. static integer c__6 = 6;
  119.  
  120. /*<       subroutine runcon(id) >*/
  121. /* Subroutine */ int runcon_(id)
  122. integer *id;
  123. {
  124.     /* Initialized data */
  125.  
  126.     static integer lsetop[5] = { 1,1,0,1,1 };
  127.     static struct {
  128.     char e_1[152];
  129.     doublereal e_2;
  130.     } equiv_76 = { {'r', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'c', ' ', ' ',
  131.          ' ', ' ', ' ', ' ', ' ', 'l', ' ', ' ', ' ', ' ', ' ', ' ', 
  132.         ' ', 'k', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'g', ' ', ' ', 
  133.         ' ', ' ', ' ', ' ', ' ', 'e', ' ', ' ', ' ', ' ', ' ', ' ', 
  134.         ' ', 'f', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'h', ' ', ' ', 
  135.         ' ', ' ', ' ', ' ', ' ', 'v', ' ', ' ', ' ', ' ', ' ', ' ', 
  136.         ' ', 'i', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'd', ' ', ' ', 
  137.         ' ', ' ', ' ', ' ', ' ', 'q', ' ', ' ', ' ', ' ', ' ', ' ', 
  138.         ' ', 'j', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'm', ' ', ' ', 
  139.         ' ', ' ', ' ', ' ', ' ', 's', ' ', ' ', ' ', ' ', ' ', ' ', 
  140.         ' ', 'y', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 't', ' ', ' ', 
  141.         ' ', ' ', ' ', ' ', ' ', 't', 'e', 'm', 'p', ' ', ' ', ' ', 
  142.         ' ', 'x', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  143.  
  144. #define aide ((doublereal *)&equiv_76)
  145.  
  146.     static struct {
  147.     char e_1[8];
  148.     doublereal e_2;
  149.     } equiv_77 = { {'d', 'e', 'c', ' ', ' ', ' ', ' ', ' '}, 0. };
  150.  
  151. #define alsde (*(doublereal *)&equiv_77)
  152.  
  153.     static struct {
  154.     char e_1[8];
  155.     doublereal e_2;
  156.     } equiv_78 = { {'o', 'c', 't', ' ', ' ', ' ', ' ', ' '}, 0. };
  157.  
  158. #define alsoc (*(doublereal *)&equiv_78)
  159.  
  160.     static struct {
  161.     char e_1[8];
  162.     doublereal e_2;
  163.     } equiv_79 = { {'l', 'i', 'n', ' ', ' ', ' ', ' ', ' '}, 0. };
  164.  
  165. #define alsli (*(doublereal *)&equiv_79)
  166.  
  167.     static struct {
  168.     char e_1[8];
  169.     doublereal e_2;
  170.     } equiv_80 = { {'t', 'r', 'a', 'p', ' ', ' ', ' ', ' '}, 0. };
  171.  
  172. #define atrap (*(doublereal *)&equiv_80)
  173.  
  174.     static struct {
  175.     char e_1[8];
  176.     doublereal e_2;
  177.     } equiv_81 = { {'g', 'e', 'a', 'r', ' ', ' ', ' ', ' '}, 0. };
  178.  
  179. #define agear (*(doublereal *)&equiv_81)
  180.  
  181.     static struct {
  182.     char e_1[8];
  183.     doublereal e_2;
  184.     } equiv_82 = { {'u', 'i', 'c', ' ', ' ', ' ', ' ', ' '}, 0. };
  185.  
  186. #define auic (*(doublereal *)&equiv_82)
  187.  
  188.     static struct {
  189.     char e_1[8];
  190.     doublereal e_2;
  191.     } equiv_83 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  192.  
  193. #define ablnk (*(doublereal *)&equiv_83)
  194.  
  195.     static struct {
  196.     char e_1[8];
  197.     doublereal e_2;
  198.     } equiv_84 = { {'i', 'n', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  199.  
  200. #define ain (*(doublereal *)&equiv_84)
  201.  
  202.     static struct {
  203.     char e_1[8];
  204.     doublereal e_2;
  205.     } equiv_85 = { {'o', 'u', 't', ' ', ' ', ' ', ' ', ' '}, 0. };
  206.  
  207. #define aout (*(doublereal *)&equiv_85)
  208.  
  209.     static struct {
  210.     char e_1[8];
  211.     doublereal e_2;
  212.     } equiv_86 = { {'*', 'm', 'i', 's', 's', 'i', 'n', 'g'}, 0. };
  213.  
  214. #define amiss (*(doublereal *)&equiv_86)
  215.  
  216.     static struct {
  217.     char e_1[8];
  218.     doublereal e_2;
  219.     } equiv_87 = { {'m', 's', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  220.  
  221. #define ams (*(doublereal *)&equiv_87)
  222.  
  223.     static integer minpts = 1;
  224.     static struct {
  225.     char e_1[40];
  226.     doublereal e_2;
  227.     } equiv_88 = { {'d', 'c', ' ', ' ', ' ', ' ', ' ', ' ', 't', 'r', ' ',
  228.          ' ', ' ', ' ', ' ', ' ', 'a', 'c', ' ', ' ', ' ', ' ', ' ', 
  229.         ' ', 'n', 'o', ' ', ' ', ' ', ' ', ' ', ' ', 'd', 'i', ' ', 
  230.         ' ', ' ', ' ', ' ', ' '}, 0. };
  231.  
  232. #define aopt ((doublereal *)&equiv_88)
  233.  
  234.     static struct {
  235.     char e_1[272];
  236.     doublereal e_2;
  237.     } equiv_89 = { {'a', 'c', 'c', 't', ' ', ' ', ' ', ' ', 'l', 'i', 's',
  238.          't', ' ', ' ', ' ', ' ', 'n', 'o', 'm', 'o', 'd', ' ', ' ', 
  239.         ' ', 'n', 'o', 'd', 'e', ' ', ' ', ' ', ' ', 'o', 'p', 't', 
  240.         's', ' ', ' ', ' ', ' ', 'i', 't', 'l', '1', ' ', ' ', ' ', 
  241.         ' ', 'i', 't', 'l', '2', ' ', ' ', ' ', ' ', 'i', 't', 'l', 
  242.         '3', ' ', ' ', ' ', ' ', 'i', 't', 'l', '4', ' ', ' ', ' ', 
  243.         ' ', 'i', 't', 'l', '5', ' ', ' ', ' ', ' ', 'i', 't', 'l', 
  244.         '6', ' ', ' ', ' ', ' ', 'l', 'i', 'm', 't', 'i', 'm', ' ', 
  245.         ' ', 'l', 'i', 'm', 'p', 't', 's', ' ', ' ', 'l', 'v', 'l', 
  246.         'c', 'o', 'd', ' ', ' ', 'l', 'v', 'l', 't', 'i', 'm', ' ', 
  247.         ' ', 'g', 'm', 'i', 'n', ' ', ' ', ' ', ' ', 'r', 'e', 'l', 
  248.         't', 'o', 'l', ' ', ' ', 'a', 'b', 's', 't', 'o', 'l', ' ', 
  249.         ' ', 'v', 'n', 't', 'o', 'l', ' ', ' ', ' ', 't', 'r', 't', 
  250.         'o', 'l', ' ', ' ', ' ', 'c', 'h', 'g', 't', 'o', 'l', ' ', 
  251.         ' ', 't', 'n', 'o', 'm', ' ', ' ', ' ', ' ', 'n', 'u', 'm', 
  252.         'd', 'g', 't', ' ', ' ', 'm', 'a', 'x', 'o', 'r', 'd', ' ', 
  253.         ' ', 'm', 'e', 't', 'h', 'o', 'd', ' ', ' ', 'n', 'o', 'p', 
  254.         'a', 'g', 'e', ' ', ' ', 'm', 'u', ' ', ' ', ' ', ' ', ' ', 
  255.         ' ', 'c', 'p', 't', 'i', 'm', 'e', ' ', ' ', 'd', 'e', 'f', 
  256.         'l', ' ', ' ', ' ', ' ', 'd', 'e', 'f', 'w', ' ', ' ', ' ', 
  257.         ' ', 'd', 'e', 'f', 'a', 'd', ' ', ' ', ' ', 'd', 'e', 'f', 
  258.         'a', 's', ' ', ' ', ' ', 'p', 'i', 'v', 't', 'o', 'l', ' ', 
  259.         ' ', 'p', 'i', 'v', 'r', 'e', 'l', ' ', ' '}, 0. };
  260.  
  261. #define aopts ((doublereal *)&equiv_89)
  262.  
  263.  
  264.     /* Format strings */
  265.     static char fmt_1131[] = "(\0020warning:  missing parameter(s) ... analy\
  266. sis omitted\002/)";
  267.     static char fmt_1241[] = "(\0020warning:  unknown frequency function: \
  268.  \002,a8,\002 ... analys\002,\002is omitted\002/)";
  269.     static char fmt_1251[] = "(\0020warning:  frequency parameters incorrect\
  270.  ... analysis om\002,\002itted\002/)";
  271.     static char fmt_1261[] = "(\0020warning:  start freq > stop freq ... ana\
  272. lysis omitted\002/)";
  273.     static char fmt_1431[] = "(\0020warning:  time parameters incorrect ... \
  274. analysis omitted\002/)";
  275.     static char fmt_1441[] = "(\0020warning:  start time > stop time ... ana\
  276. lysis omitted\002/)";
  277.     static char fmt_1541[] = "(\0020warning:  illegal output variable ... an\
  278. alysis omitted\002/)";
  279.     static char fmt_1611[] = "(\0020warning:  voltage output unrecognizable \
  280. ... analysis omitted\002/)";
  281.     static char fmt_1621[] = "(\0020warning:  invalid input source ... analy\
  282. sis omitted\002/)";
  283.     static char fmt_1661[] = "(\0020warning:  distortion load resistor missi\
  284. ng ... analysis \002,\002omitted\002/)";
  285.     static char fmt_1671[] = "(\0020warning:  distortion parameters incorrec\
  286. t ... analysis o\002,\002mitted\002/)";
  287.     static char fmt_1721[] = "(\0020warning:  fourier parameters incorrect .\
  288. .. analysis omit\002,\002ted\002/)";
  289.     static char fmt_1781[] = "(\0020warning:  output variable unrecognizable\
  290.  ... analysis om\002,\002mitted\002/)";
  291.     static char fmt_2081[] = "(\0020warning:  numdgt may not exceed\002,i2\
  292. ,\002;  maximum value assumed\002/)";
  293.     static char fmt_2501[] = "(\0020warning:  unknown option:  \002,a8,\002 \
  294. ... ignored\002/)";
  295.     static char fmt_2511[] = "(\0020warning:  illegal value specified for op\
  296. tion:  \002,a8,\002 ... ignored\002/)";
  297.     static char fmt_3951[] = "(\0020warning:  unknown analysis mode:  \002,a\
  298. 8,\002 ... line ignored\002/)";
  299.     static char fmt_3971[] = "(\0020warning:  unrecognizable output variable\
  300.  on above line\002/)";
  301.     static char fmt_4171[] = "(\0020warning: out-of-place non-numeric field\
  302.  \002,a8,\002 skipped\002/)";
  303.     static char fmt_4181[] = "(\0020warning: initial value missing for node\
  304.  \002,i5,/)";
  305.     static char fmt_4191[] = "(\0020warning: attempt to specify initial cond\
  306. ition for \002,\002ground ingnored\002,/)";
  307.     static char fmt_4271[] = "(\0020warning: out-of-place non-numeric field\
  308.  \002,a8,\002 skipped\002/)";
  309.     static char fmt_4281[] = "(\0020warning: initial value missing for node\
  310.  \002,i5,/)";
  311.     static char fmt_4291[] = "(\0020warning: attempt to specify initial cond\
  312. ition for \002,\002ground ignored\002,/)";
  313.     static char fmt_5931[] = "(\002 *debug*:  runcon - idebug(\002,i2,\002) \
  314. set to \002,i10)";
  315.  
  316.     /* System generated locals */
  317.     integer i_1;
  318.     doublereal d_1, d_2;
  319.  
  320.     /* Builtin functions */
  321.     integer s_wsfe(), e_wsfe();
  322.     double exp(), log();
  323.     integer do_fio();
  324.  
  325.     /* Local variables */
  326.     static doublereal anam;
  327.     static integer ifld;
  328.     extern /* Subroutine */ int find_();
  329.     static doublereal aval;
  330.     static integer ival, inum;
  331.     extern /* Subroutine */ int move_();
  332.     static integer locs;
  333.     static doublereal temp;
  334.     static integer loct, locv;
  335.     extern integer xxor_();
  336.     extern /* Subroutine */ int getm4_();
  337.     static integer i, n;
  338. #define dflts ((doublereal *)&miscel_1 + 15)
  339. #define iprnt ((integer *)&flags_1)
  340.     static integer itemp, ktype, ntype, ltype, jtype, iprpl, lspot, index, ms;
  341.  
  342. #define nodplc ((integer *)&blank_1)
  343. #define cvalue ((complex *)&blank_1)
  344. #define limits ((integer *)&flags_1 + 5)
  345. #define itrlim ((integer *)&flags_1 + 9)
  346. #define contol ((doublereal *)&knstnt_1 + 8)
  347.     extern /* Subroutine */ int extmem_(), outdef_(), clrmem_();
  348.     static integer ndigit, loc;
  349.     static doublereal plimlo, plimhi;
  350.     static integer nodnum;
  351.     extern /* Subroutine */ int sizmem_();
  352.     static integer nic;
  353.  
  354.     /* Fortran I/O blocks */
  355.     static cilist io__30 = { 0, 0, 0, fmt_1131, 0 };
  356.     static cilist io__31 = { 0, 0, 0, fmt_1241, 0 };
  357.     static cilist io__32 = { 0, 0, 0, fmt_1251, 0 };
  358.     static cilist io__33 = { 0, 0, 0, fmt_1261, 0 };
  359.     static cilist io__34 = { 0, 0, 0, fmt_1431, 0 };
  360.     static cilist io__35 = { 0, 0, 0, fmt_1441, 0 };
  361.     static cilist io__37 = { 0, 0, 0, fmt_1131, 0 };
  362.     static cilist io__38 = { 0, 0, 0, fmt_1541, 0 };
  363.     static cilist io__40 = { 0, 0, 0, fmt_1611, 0 };
  364.     static cilist io__41 = { 0, 0, 0, fmt_1621, 0 };
  365.     static cilist io__42 = { 0, 0, 0, fmt_1661, 0 };
  366.     static cilist io__43 = { 0, 0, 0, fmt_1671, 0 };
  367.     static cilist io__46 = { 0, 0, 0, fmt_1721, 0 };
  368.     static cilist io__47 = { 0, 0, 0, fmt_1781, 0 };
  369.     static cilist io__51 = { 0, 0, 0, fmt_2081, 0 };
  370.     static cilist io__54 = { 0, 0, 0, fmt_2501, 0 };
  371.     static cilist io__55 = { 0, 0, 0, fmt_2511, 0 };
  372.     static cilist io__63 = { 0, 0, 0, fmt_3951, 0 };
  373.     static cilist io__64 = { 0, 0, 0, fmt_3971, 0 };
  374.     static cilist io__67 = { 0, 0, 0, fmt_4171, 0 };
  375.     static cilist io__68 = { 0, 0, 0, fmt_4181, 0 };
  376.     static cilist io__69 = { 0, 0, 0, fmt_4191, 0 };
  377.     static cilist io__70 = { 0, 0, 0, fmt_4271, 0 };
  378.     static cilist io__71 = { 0, 0, 0, fmt_4281, 0 };
  379.     static cilist io__72 = { 0, 0, 0, fmt_4291, 0 };
  380.     static cilist io__75 = { 0, 0, 0, fmt_5931, 0 };
  381.  
  382.  
  383. /*<       implicit double precision (a-h,o-z) >*/
  384.  
  385. /*     this routine processes run control cards. */
  386.  
  387. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  388. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  389. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  390. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  391. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  392. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  393. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  394. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  395. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  396. /* spice version 2g.6  sccsid=cje 3/15/83 */
  397. /*<       common /cje/ maxtim,itime,icost >*/
  398. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  399. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  400. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  401. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  402. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  403. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  404. /* spice version 2g.6  sccsid=status 3/15/83 */
  405. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  406. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  407. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  408. /* spice version 2g.6  sccsid=flags 3/15/83 */
  409. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  410. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  411. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  412. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  413. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  414. /*<      2   pivtol,pivrel >*/
  415. /* spice version 2g.6  sccsid=dc 3/15/83 */
  416. /*<       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
  417. /*<      1   kinel,kidin,kovar,kidout >*/
  418. /* spice version 2g.6  sccsid=ac 3/15/83 */
  419. /*<       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
  420. /*<      1   inoise,nosprt,nosout,nosin,idist,idprt >*/
  421. /* spice version 2g.6  sccsid=tran 3/15/83 */
  422. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  423. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  424. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  425. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  426. /* spice version 2g.6  sccsid=debug 3/15/83 */
  427. /*<       common/debug/ idebug(20) >*/
  428. /* spice version 2g.6  sccsid=blank 3/15/83 */
  429. /*<       common /blank/ value(200000) >*/
  430. /*<       integer nodplc(64) >*/
  431. /*<       complex cvalue(32) >*/
  432. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  433. /*<       dimension iprnt(5),limits(4),itrlim(6),contol(6),dflts(4) >*/
  434. /*<       equivalence (iprnt(1),iprnta),(limits(1),limtim),(itrlim(1),itl1), >*/
  435. /*<      1   (contol(1),gmin),(dflts(1),defl) >*/
  436.  
  437.  
  438. /*<       integer xxor >*/
  439.  
  440. /*  print/plot keywords */
  441.  
  442. /*<       dimension aopt(5) >*/
  443. /*<       dimension aopts(34),lsetop(5) >*/
  444. /*<       dimension aide(20) >*/
  445. /*<       data aopt / 2hdc, 2htr, 2hac, 2hno, 2hdi / >*/
  446.  
  447. /*  options card keywords */
  448.  
  449. /*<       data aopts / 6hacct  , 6hlist  , 6hnomod , 6hnode  , 6hopts  , >*/
  450. /*<      1             6hitl1  , 6hitl2  , 6hitl3  , 6hitl4  , 6hitl5  , >*/
  451. /*<      2             6hitl6  , 6hlimtim, 6hlimpts, 6hlvlcod, 6hlvltim, >*/
  452. /*<      3             6hgmin  , 6hreltol, 6habstol, 6hvntol , 6htrtol , >*/
  453. /*<      4             6hchgtol, 6htnom  , 6hnumdgt, 6hmaxord, 6hmethod, >*/
  454. /*<      5             6hnopage, 6hmu    , 6hcptime, 6hdefl  , 6hdefw  , >*/
  455. /*<      6             6hdefad , 6hdefas , 6hpivtol, 6hpivrel / >*/
  456. /*<       data lsetop / 1 ,1, 0, 1, 1 / >*/
  457.  
  458.  
  459. /*<       data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj, >*/
  460. /*<      1   1hm,1hs,1hy,1ht,4htemp,1hx,0.0d0 / >*/
  461. /*<       data alsde,alsoc,alsli / 3hdec, 3hoct, 3hlin / >*/
  462. /*<       data atrap, agear, auic / 4htrap, 4hgear, 3huic / >*/
  463. /*<       data ablnk, ain, aout / 1h , 2hin, 3hout / >*/
  464. /*<       data amiss / 8h*missing / >*/
  465. /*<       data ams / 2hms / >*/
  466. /*<       data minpts / 1 / >*/
  467.  
  468.  
  469. /*<       go to (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600, >*/
  470. /*<      1   3500,6000,1750,1300,1500,1800,4000,4100,4200,5900), id >*/
  471.     switch (*id) {
  472.     case 1:  goto L1200;
  473.     case 2:  goto L1100;
  474.     case 3:  goto L1650;
  475.     case 4:  goto L6000;
  476.     case 5:  goto L6000;
  477.     case 6:  goto L1700;
  478.     case 7:  goto L6000;
  479.     case 8:  goto L1600;
  480.     case 9:  goto L1550;
  481.     case 10:  goto L2000;
  482.     case 11:  goto L3600;
  483.     case 12:  goto L3500;
  484.     case 13:  goto L6000;
  485.     case 14:  goto L1750;
  486.     case 15:  goto L1300;
  487.     case 16:  goto L1500;
  488.     case 17:  goto L1800;
  489.     case 18:  goto L4000;
  490.     case 19:  goto L4100;
  491.     case 20:  goto L4200;
  492.     case 21:  goto L5900;
  493.     }
  494.  
  495. /*  dc transfer curves */
  496.  
  497. /*<  1100 ifld=2 >*/
  498. L1100:
  499.     ifld = 2;
  500. /*<       icvflg=0 >*/
  501.     dc_1.icvflg = 0;
  502. /*<       inum=1 >*/
  503.     inum = 1;
  504. /*<  1105 anam=value(ifield+ifld) >*/
  505. L1105:
  506.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  507. /*<       if(inum.gt.2) go to 6000 >*/
  508.     if (inum > 2) {
  509.     goto L6000;
  510.     }
  511. /*<       id=0 >*/
  512.     *id = 0;
  513. /*<       call move(anam,2,ablnk,1,7) >*/
  514.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  515. /*<       if (anam.eq.aide(1)) id=1 >*/
  516.     if (anam == aide[0]) {
  517.     *id = 1;
  518.     }
  519. /*<       if (anam.eq.aide(9)) id=9 >*/
  520.     if (anam == aide[8]) {
  521.     *id = 9;
  522.     }
  523. /*<       if (anam.eq.aide(10)) id=10 >*/
  524.     if (anam == aide[9]) {
  525.     *id = 10;
  526.     }
  527. /*<       if (anam.eq.aide(17)) go to 1108 >*/
  528.     if (anam == aide[16]) {
  529.     goto L1108;
  530.     }
  531. /*<       if (id.eq.0) go to 1130 >*/
  532.     if (*id == 0) {
  533.     goto L1130;
  534.     }
  535. /*<       call find(value(ifield+ifld),id,itcelm(inum),0) >*/
  536.     find_(&blank_1.value[tabinf_1.ifield + ifld - 1], id, &dc_1.itcelm[inum - 
  537.         1], &c__0);
  538. /*<       go to 1115 >*/
  539.     goto L1115;
  540. /*<  1108 anam=value(ifield+ifld) >*/
  541. L1108:
  542.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  543. /*<       call move(anam,5,ablnk,1,4) >*/
  544.     move_(&anam, &c__5, &ablnk, &c__1, &c__4);
  545. /*<       if (anam.ne.aide(18)) go to 1130 >*/
  546.     if (anam != aide[17]) {
  547.     goto L1130;
  548.     }
  549. /*<       id=18 >*/
  550.     *id = 18;
  551. /*<       call find(anam,id,itcelm(inum),1) >*/
  552.     find_(&anam, id, &dc_1.itcelm[inum - 1], &c__1);
  553. /*<       locs=nodplc(itcelm(inum)+1) >*/
  554.     locs = nodplc[dc_1.itcelm[inum - 1]];
  555. /*<       nodplc(itcelm(inum)+2)=0 >*/
  556.     nodplc[dc_1.itcelm[inum - 1] + 1] = 0;
  557. /*<       value(locs)=anam >*/
  558.     blank_1.value[locs - 1] = anam;
  559. /*<       value(locs+1)=value(itemps+1) >*/
  560.     blank_1.value[locs] = blank_1.value[tabinf_1.itemps];
  561. /*<       call extmem(itemps,2) >*/
  562.     extmem_(&tabinf_1.itemps, &c__2);
  563. /*<       value(itemps+2)=value(itemps+1) >*/
  564.     blank_1.value[tabinf_1.itemps + 1] = blank_1.value[tabinf_1.itemps];
  565. /*<  1115 ifld=ifld+1 >*/
  566. L1115:
  567.     ++ifld;
  568. /*<       if (nodplc(icode+ifld).ne.0) go to 1130 >*/
  569.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  570.     goto L1130;
  571.     }
  572. /*<       tcstar(inum)=value(ifield+ifld) >*/
  573.     dc_1.tcstar[inum - 1] = blank_1.value[tabinf_1.ifield + ifld - 1];
  574. /*<       ifld=ifld+1 >*/
  575.     ++ifld;
  576. /*<       if (nodplc(icode+ifld).ne.0) go to 1130 >*/
  577.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  578.     goto L1130;
  579.     }
  580. /*<       tcstop(inum)=value(ifield+ifld) >*/
  581.     dc_1.tcstop[inum - 1] = blank_1.value[tabinf_1.ifield + ifld - 1];
  582. /*<       ifld=ifld+1 >*/
  583.     ++ifld;
  584. /*<       if (nodplc(icode+ifld).ne.0) go to 1130 >*/
  585.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  586.     goto L1130;
  587.     }
  588. /*<       tcincr(inum)=value(ifield+ifld) >*/
  589.     dc_1.tcincr[inum - 1] = blank_1.value[tabinf_1.ifield + ifld - 1];
  590. /*<       if (tcincr(inum).eq.0.0d0) go to 1130 >*/
  591.     if (dc_1.tcincr[inum - 1] == 0.) {
  592.     goto L1130;
  593.     }
  594. /*<       temp=(tcstop(inum)-tcstar(inum))/tcincr(inum) >*/
  595.     temp = (dc_1.tcstop[inum - 1] - dc_1.tcstar[inum - 1]) / dc_1.tcincr[inum 
  596.         - 1];
  597. /*<       if (temp.gt.0.0d0) go to 1110 >*/
  598.     if (temp > 0.) {
  599.     goto L1110;
  600.     }
  601. /*<       tcincr(inum)=-tcincr(inum) >*/
  602.     dc_1.tcincr[inum - 1] = -dc_1.tcincr[inum - 1];
  603. /*<       temp=-temp >*/
  604.     temp = -temp;
  605. /*<  1110 itemp=idint(temp+0.5d0)+1 >*/
  606. L1110:
  607.     itemp = (integer) (temp + .5) + 1;
  608. /*<       itemp=max0(itemp,minpts) >*/
  609.     itemp = max(itemp,minpts);
  610. /*<       if(inum.eq.1) icvflg=itemp >*/
  611.     if (inum == 1) {
  612.     dc_1.icvflg = itemp;
  613.     }
  614. /*<       if(inum.eq.2) icvflg=itemp*icvflg >*/
  615.     if (inum == 2) {
  616.     dc_1.icvflg = itemp * dc_1.icvflg;
  617.     }
  618. /*<       ifld=ifld+1 >*/
  619.     ++ifld;
  620. /*<       inum=2 >*/
  621.     inum = 2;
  622. /*<       if(nodplc(icode+ifld)) 6000,1130,1105 >*/
  623.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  624.     goto L6000;
  625.     } else if (i_1 == 0) {
  626.     goto L1130;
  627.     } else {
  628.     goto L1105;
  629.     }
  630. /*<  1130 write (iofile,1131) >*/
  631. L1130:
  632.     io__30.ciunit = status_1.iofile;
  633.     s_wsfe(&io__30);
  634.     e_wsfe();
  635. /*<       icvflg=0 >*/
  636.     dc_1.icvflg = 0;
  637. /*<  1131 format('0warning:  missing parameter(s) ... analysis omitted'/) >*/
  638. /*<       go to 6000 >*/
  639.     goto L6000;
  640.  
  641. /*  frequency specification */
  642.  
  643. /*<  1200 ifld=2 >*/
  644. L1200:
  645.     ifld = 2;
  646. /*<       if (nodplc(icode+2)) 1250,1250,1210 >*/
  647.     if (nodplc[tabinf_1.icode + 1] <= 0) {
  648.     goto L1250;
  649.     } else {
  650.     goto L1210;
  651.     }
  652. /*<  1210 id=0 >*/
  653. L1210:
  654.     *id = 0;
  655. /*<       if (value(ifield+ifld).eq.alsde) id=1 >*/
  656.     if (blank_1.value[tabinf_1.ifield + ifld - 1] == alsde) {
  657.     *id = 1;
  658.     }
  659. /*<       if (value(ifield+ifld).eq.alsoc) id=2 >*/
  660.     if (blank_1.value[tabinf_1.ifield + ifld - 1] == alsoc) {
  661.     *id = 2;
  662.     }
  663. /*<       if (value(ifield+ifld).eq.alsli) id=3 >*/
  664.     if (blank_1.value[tabinf_1.ifield + ifld - 1] == alsli) {
  665.     *id = 3;
  666.     }
  667. /*<       if (id.eq.0) go to 1240 >*/
  668.     if (*id == 0) {
  669.     goto L1240;
  670.     }
  671. /*<       idfreq=id >*/
  672.     ac_1.idfreq = *id;
  673. /*<       ifld=ifld+1 >*/
  674.     ++ifld;
  675. /*<       if (nodplc(icode+ifld).ne.0) go to 1250 >*/
  676.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  677.     goto L1250;
  678.     }
  679. /*<       if (value(ifield+ifld).le.0.0d0) go to 1250 >*/
  680.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  681.     goto L1250;
  682.     }
  683. /*<       fincr=value(ifield+ifld) >*/
  684.     ac_1.fincr = blank_1.value[tabinf_1.ifield + ifld - 1];
  685. /*<       ifld=ifld+1 >*/
  686.     ++ifld;
  687. /*<       if (nodplc(icode+ifld).ne.0) go to 1250 >*/
  688.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  689.     goto L1250;
  690.     }
  691. /*<       if (value(ifield+ifld).le.0.0d0) go to 1250 >*/
  692.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  693.     goto L1250;
  694.     }
  695. /*<       fstart=value(ifield+ifld) >*/
  696.     ac_1.fstart = blank_1.value[tabinf_1.ifield + ifld - 1];
  697. /*<       ifld=ifld+1 >*/
  698.     ++ifld;
  699. /*<       if (nodplc(icode+ifld).ne.0) go to 1250 >*/
  700.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  701.     goto L1250;
  702.     }
  703. /*<       if (value(ifield+ifld).le.0.0d0) go to 1250 >*/
  704.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  705.     goto L1250;
  706.     }
  707. /*<       fstop=value(ifield+ifld) >*/
  708.     ac_1.fstop = blank_1.value[tabinf_1.ifield + ifld - 1];
  709. /*<       if (fstart.gt.fstop) go to 1260 >*/
  710.     if (ac_1.fstart > ac_1.fstop) {
  711.     goto L1260;
  712.     }
  713. /*<       jacflg=fincr >*/
  714.     ac_1.jacflg = (integer) ac_1.fincr;
  715. /*<       if (idfreq-2) 1215,1220,1235 >*/
  716.     if ((i_1 = ac_1.idfreq - 2) < 0) {
  717.     goto L1215;
  718.     } else if (i_1 == 0) {
  719.     goto L1220;
  720.     } else {
  721.     goto L1235;
  722.     }
  723. /*<  1215 fincr=dexp(xlog10/fincr) >*/
  724. L1215:
  725.     ac_1.fincr = exp(knstnt_1.xlog10 / ac_1.fincr);
  726. /*<       go to 1230 >*/
  727.     goto L1230;
  728. /*<  1220 fincr=dexp(xlog2/fincr) >*/
  729. L1220:
  730.     ac_1.fincr = exp(knstnt_1.xlog2 / ac_1.fincr);
  731. /*<  1230 temp=dlog(fstop/fstart)/dlog(fincr) >*/
  732. L1230:
  733.     temp = log(ac_1.fstop / ac_1.fstart) / log(ac_1.fincr);
  734. /*<       jacflg=idint(temp+0.999d0)+1 >*/
  735.     ac_1.jacflg = (integer) (temp + .999) + 1;
  736. /*<  1235 jacflg=max0(jacflg,minpts) >*/
  737. L1235:
  738.     ac_1.jacflg = max(ac_1.jacflg,minpts);
  739. /*<       if (idfreq.ne.3) go to 6000 >*/
  740.     if (ac_1.idfreq != 3) {
  741.     goto L6000;
  742.     }
  743. /*<       fincr=(fstop-fstart)/dble(max0(jacflg-1,1)) >*/
  744. /* Computing MAX */
  745.     i_1 = ac_1.jacflg - 1;
  746.     ac_1.fincr = (ac_1.fstop - ac_1.fstart) / (doublereal) max(1,i_1);
  747. /*<       go to 6000 >*/
  748.     goto L6000;
  749. /*<  1240 write (iofile,1241) value(ifield+ifld) >*/
  750. L1240:
  751.     io__31.ciunit = status_1.iofile;
  752.     s_wsfe(&io__31);
  753.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.ifield + ifld - 1], (ftnlen)
  754.         sizeof(doublereal));
  755.     e_wsfe();
  756. /*<  1241 format('0warning:  unknown frequency function:  ',a8,' ... analys' >*/
  757. /*<      1   ,'is omitted'/) >*/
  758. /*<       go to 6000 >*/
  759.     goto L6000;
  760. /*<  1250 write (iofile,1251) >*/
  761. L1250:
  762.     io__32.ciunit = status_1.iofile;
  763.     s_wsfe(&io__32);
  764.     e_wsfe();
  765. /*<  1251 format('0warning:  frequency parameters incorrect ... analysis om' >*/
  766. /*<      1   ,'itted'/) >*/
  767. /*<       go to 6000 >*/
  768.     goto L6000;
  769. /*<  1260 write (iofile,1261) >*/
  770. L1260:
  771.     io__33.ciunit = status_1.iofile;
  772.     s_wsfe(&io__33);
  773.     e_wsfe();
  774. /*<  1261 format('0warning:  start freq > stop freq ... analysis omitted'/) >*/
  775. /*<       go to 6000 >*/
  776.     goto L6000;
  777.  
  778. /*  time specification */
  779.  
  780. /*<  1300 ifld=2 >*/
  781. L1300:
  782.     ifld = 2;
  783. /*<       if (nodplc(icode+ifld).ne.0) go to 1430 >*/
  784.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  785.     goto L1430;
  786.     }
  787. /*<       if (value(ifield+ifld).le.0.0d0) go to 1430 >*/
  788.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  789.     goto L1430;
  790.     }
  791. /*<       tstep=value(ifield+ifld) >*/
  792.     tran_1.tstep = blank_1.value[tabinf_1.ifield + ifld - 1];
  793. /*<       ifld=ifld+1 >*/
  794.     ++ifld;
  795. /*<       if (nodplc(icode+ifld).ne.0) go to 1430 >*/
  796.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  797.     goto L1430;
  798.     }
  799. /*<       if (value(ifield+ifld).le.0.0d0) go to 1430 >*/
  800.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  801.     goto L1430;
  802.     }
  803. /*<       tstop=value(ifield+ifld) >*/
  804.     tran_1.tstop = blank_1.value[tabinf_1.ifield + ifld - 1];
  805. /*<       tstart=0.0d0 >*/
  806.     tran_1.tstart = 0.;
  807. /*<       delmax=tstop/50.0d0 >*/
  808.     tran_1.delmax = tran_1.tstop / 50.;
  809. /*<       ifld=ifld+1 >*/
  810.     ++ifld;
  811. /*<       if (nodplc(icode+ifld).ne.0) go to 1310 >*/
  812.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  813.     goto L1310;
  814.     }
  815. /*<       if (value(ifield+ifld).lt.0.0d0) go to 1430 >*/
  816.     if (blank_1.value[tabinf_1.ifield + ifld - 1] < 0.) {
  817.     goto L1430;
  818.     }
  819. /*<       tstart=value(ifield+ifld) >*/
  820.     tran_1.tstart = blank_1.value[tabinf_1.ifield + ifld - 1];
  821. /*<       delmax=(tstop-tstart)/50.0d0 >*/
  822.     tran_1.delmax = (tran_1.tstop - tran_1.tstart) / 50.;
  823. /*<       ifld=ifld+1 >*/
  824.     ++ifld;
  825. /*<       if (nodplc(icode+ifld).ne.0) go to 1310 >*/
  826.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  827.     goto L1310;
  828.     }
  829. /*<       if (value(ifield+ifld).le.0.0d0) go to 1430 >*/
  830.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  831.     goto L1430;
  832.     }
  833. /*<       delmax=value(ifield+ifld) >*/
  834.     tran_1.delmax = blank_1.value[tabinf_1.ifield + ifld - 1];
  835. /*<       ifld=ifld+1 >*/
  836.     ++ifld;
  837. /*<  1310 if (nodplc(icode+ifld).ne.1) go to 1320 >*/
  838. L1310:
  839.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  840.     goto L1320;
  841.     }
  842. /*<       if (value(ifield+ifld).ne.auic) go to 1320 >*/
  843.     if (blank_1.value[tabinf_1.ifield + ifld - 1] != auic) {
  844.     goto L1320;
  845.     }
  846. /*<       nosolv=1 >*/
  847.     status_1.nosolv = 1;
  848. /*<  1320 if (tstart.gt.tstop) go to 1440 >*/
  849. L1320:
  850.     if (tran_1.tstart > tran_1.tstop) {
  851.     goto L1440;
  852.     }
  853. /*<       if (tstep.gt.tstop) go to 1430 >*/
  854.     if (tran_1.tstep > tran_1.tstop) {
  855.     goto L1430;
  856.     }
  857. /*<       jtrflg=idint((tstop-tstart)/tstep+0.5d0)+1 >*/
  858.     tran_1.jtrflg = (integer) ((tran_1.tstop - tran_1.tstart) / tran_1.tstep 
  859.         + .5) + 1;
  860. /*<       jtrflg=max0(jtrflg,minpts) >*/
  861.     tran_1.jtrflg = max(tran_1.jtrflg,minpts);
  862. /*<       go to 6000 >*/
  863.     goto L6000;
  864. /*<  1430 write (iofile,1431) >*/
  865. L1430:
  866.     io__34.ciunit = status_1.iofile;
  867.     s_wsfe(&io__34);
  868.     e_wsfe();
  869. /*<  1431 format('0warning:  time parameters incorrect ... analysis omitted' >*/
  870. /*<      1   /) >*/
  871. /*<       go to 6000 >*/
  872.     goto L6000;
  873. /*<  1440 write (iofile,1441) >*/
  874. L1440:
  875.     io__35.ciunit = status_1.iofile;
  876.     s_wsfe(&io__35);
  877.     e_wsfe();
  878. /*<  1441 format('0warning:  start time > stop time ... analysis omitted'/) >*/
  879. /*<       go to 6000 >*/
  880.     goto L6000;
  881.  
  882. /*  transfer function */
  883.  
  884. /*<  1500 kssop=1 >*/
  885. L1500:
  886.     dc_1.kssop = 1;
  887. /*<       ifld=2 >*/
  888.     ifld = 2;
  889. /*<       if (nodplc(icode+ifld).ne.1) go to 1530 >*/
  890.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  891.     goto L1530;
  892.     }
  893. /*<       call outdef(ifld,1,kovar,ktype) >*/
  894.     outdef_(&ifld, &c__1, &dc_1.kovar, &ktype);
  895. /*<       if (igoof.ne.0) go to 1530 >*/
  896.     if (flags_1.igoof != 0) {
  897.     goto L1530;
  898.     }
  899. /*<       if (ktype.ne.1) go to 1540 >*/
  900.     if (ktype != 1) {
  901.     goto L1540;
  902.     }
  903. /*<       ifld=ifld+1 >*/
  904.     ++ifld;
  905. /*<       if (nodplc(icode+ifld).ne.1) go to 1530 >*/
  906.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  907.     goto L1530;
  908.     }
  909. /*<       anam=value(ifield+ifld) >*/
  910.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  911. /*<       call move(anam,2,ablnk,1,7) >*/
  912.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  913. /*<       id=0 >*/
  914.     *id = 0;
  915. /*<       if (anam.eq.aide(9)) id=9 >*/
  916.     if (anam == aide[8]) {
  917.     *id = 9;
  918.     }
  919. /*<       if (anam.eq.aide(10)) id=10 >*/
  920.     if (anam == aide[9]) {
  921.     *id = 10;
  922.     }
  923. /*<       if (id.eq.0) go to 1530 >*/
  924.     if (*id == 0) {
  925.     goto L1530;
  926.     }
  927. /*<       call find(value(ifield+ifld),id,kinel,0) >*/
  928.     find_(&blank_1.value[tabinf_1.ifield + ifld - 1], id, &dc_1.kinel, &c__0);
  929.  
  930. /*<       kidin=id >*/
  931.     dc_1.kidin = *id;
  932. /*<       go to 6000 >*/
  933.     goto L6000;
  934. /*<  1530 kovar=0 >*/
  935. L1530:
  936.     dc_1.kovar = 0;
  937. /*<       kinel=0 >*/
  938.     dc_1.kinel = 0;
  939. /*<       write (iofile,1131) >*/
  940.     io__37.ciunit = status_1.iofile;
  941.     s_wsfe(&io__37);
  942.     e_wsfe();
  943. /*<       igoof=0 >*/
  944.     flags_1.igoof = 0;
  945. /*<       go to 6000 >*/
  946.     goto L6000;
  947. /*<  1540 kovar=0 >*/
  948. L1540:
  949.     dc_1.kovar = 0;
  950. /*<       kinel=0 >*/
  951.     dc_1.kinel = 0;
  952. /*<       write (iofile,1541) >*/
  953.     io__38.ciunit = status_1.iofile;
  954.     s_wsfe(&io__38);
  955.     e_wsfe();
  956. /*<  1541 format('0warning:  illegal output variable ... analysis omitted'/) >*/
  957. /*<       igoof=0 >*/
  958.     flags_1.igoof = 0;
  959. /*<       go to 6000 >*/
  960.     goto L6000;
  961.  
  962. /*  operating point */
  963.  
  964. /*<  1550 kssop=1 >*/
  965. L1550:
  966.     dc_1.kssop = 1;
  967. /*<       go to 6000 >*/
  968.     goto L6000;
  969.  
  970. /*  noise analysis */
  971.  
  972. /*<  1600 ifld=2 >*/
  973. L1600:
  974.     ifld = 2;
  975. /*<       if (nodplc(icode+ifld).ne.1) go to 1610 >*/
  976.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  977.     goto L1610;
  978.     }
  979. /*<       call outdef(ifld,2,nosout,ntype) >*/
  980.     outdef_(&ifld, &c__2, &ac_1.nosout, &ntype);
  981. /*<       if (igoof.ne.0) go to 1610 >*/
  982.     if (flags_1.igoof != 0) {
  983.     goto L1610;
  984.     }
  985. /*<       if (ntype.ne.1) go to 1610 >*/
  986.     if (ntype != 1) {
  987.     goto L1610;
  988.     }
  989. /*<       if (nodplc(nosout+5).ne.0) go to 1610 >*/
  990.     if (nodplc[ac_1.nosout + 4] != 0) {
  991.     goto L1610;
  992.     }
  993. /*<       ifld=ifld+1 >*/
  994.     ++ifld;
  995. /*<       if (nodplc(icode+ifld).ne.1) go to 1620 >*/
  996.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  997.     goto L1620;
  998.     }
  999. /*<       anam=value(ifield+ifld) >*/
  1000.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1001. /*<       call move(anam,2,ablnk,1,7) >*/
  1002.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  1003. /*<       id=0 >*/
  1004.     *id = 0;
  1005. /*<       if (anam.eq.aide(9)) id=9 >*/
  1006.     if (anam == aide[8]) {
  1007.     *id = 9;
  1008.     }
  1009. /*<       if (anam.eq.aide(10)) id=10 >*/
  1010.     if (anam == aide[9]) {
  1011.     *id = 10;
  1012.     }
  1013. /*<       if (id.eq.0) go to 1620 >*/
  1014.     if (*id == 0) {
  1015.     goto L1620;
  1016.     }
  1017. /*<       call find(value(ifield+ifld),id,nosin,0) >*/
  1018.     find_(&blank_1.value[tabinf_1.ifield + ifld - 1], id, &ac_1.nosin, &c__0);
  1019.  
  1020. /*<       nosprt=0 >*/
  1021.     ac_1.nosprt = 0;
  1022. /*<       ifld=ifld+1 >*/
  1023.     ++ifld;
  1024. /*<       if (nodplc(icode+ifld).ne.0) go to 1605 >*/
  1025.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1026.     goto L1605;
  1027.     }
  1028. /*<       nosprt=dmax1(0.0d0,value(ifield+ifld)) >*/
  1029. /* Computing MAX */
  1030.     d_1 = 0., d_2 = blank_1.value[tabinf_1.ifield + ifld - 1];
  1031.     ac_1.nosprt = (integer) max(d_2,d_1);
  1032. /*<  1605 inoise=1 >*/
  1033. L1605:
  1034.     ac_1.inoise = 1;
  1035. /*<       go to 6000 >*/
  1036.     goto L6000;
  1037. /*<  1610 write (iofile,1611) >*/
  1038. L1610:
  1039.     io__40.ciunit = status_1.iofile;
  1040.     s_wsfe(&io__40);
  1041.     e_wsfe();
  1042. /*<  1611 format('0warning:  voltage output unrecognizable ... analysis omit >*/
  1043. /*<      1ted'/) >*/
  1044. /*<       igoof=0 >*/
  1045.     flags_1.igoof = 0;
  1046. /*<       go to 6000 >*/
  1047.     goto L6000;
  1048. /*<  1620 write (iofile,1621) >*/
  1049. L1620:
  1050.     io__41.ciunit = status_1.iofile;
  1051.     s_wsfe(&io__41);
  1052.     e_wsfe();
  1053. /*<  1621 format('0warning:  invalid input source ... analysis omitted'/) >*/
  1054. /*<       igoof=0 >*/
  1055.     flags_1.igoof = 0;
  1056. /*<       go to 6000 >*/
  1057.     goto L6000;
  1058.  
  1059. /*  distortion analysis */
  1060.  
  1061. /*<  1650 ifld=2 >*/
  1062. L1650:
  1063.     ifld = 2;
  1064. /*<       if (nodplc(icode+ifld).ne.1) go to 1660 >*/
  1065.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1066.     goto L1660;
  1067.     }
  1068. /*<       anam=value(ifield+ifld) >*/
  1069.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1070. /*<       call move(anam,2,ablnk,1,7) >*/
  1071.     move_(&anam, &c__2, &ablnk, &c__1, &c__7);
  1072. /*<       if (anam.ne.aide(1)) go to 1660 >*/
  1073.     if (anam != aide[0]) {
  1074.     goto L1660;
  1075.     }
  1076. /*<       call find(value(ifield+ifld),1,idist,0) >*/
  1077.     find_(&blank_1.value[tabinf_1.ifield + ifld - 1], &c__1, &ac_1.idist, &
  1078.         c__0);
  1079. /*<       idprt=0 >*/
  1080.     ac_1.idprt = 0;
  1081. /*<       skw2=0.9d0 >*/
  1082.     ac_1.skw2 = .9;
  1083. /*<       refprl=1.0d-3 >*/
  1084.     ac_1.refprl = .001;
  1085. /*<       spw2=1.0d0 >*/
  1086.     ac_1.spw2 = 1.;
  1087. /*<       ifld=ifld+1 >*/
  1088.     ++ifld;
  1089. /*<       if (nodplc(icode+ifld).ne.0) go to 6000 >*/
  1090.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1091.     goto L6000;
  1092.     }
  1093. /*<       idprt=value(ifield+ifld) >*/
  1094.     ac_1.idprt = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  1095. /*<       idprt=max0(idprt,0) >*/
  1096.     ac_1.idprt = max(ac_1.idprt,0);
  1097. /*<       ifld=ifld+1 >*/
  1098.     ++ifld;
  1099. /*<       if (nodplc(icode+ifld).ne.0) go to 6000 >*/
  1100.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1101.     goto L6000;
  1102.     }
  1103. /*<       if (value(ifield+ifld).le.0.001d0) go to 1670 >*/
  1104.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= .001) {
  1105.     goto L1670;
  1106.     }
  1107. /*<       if (value(ifield+ifld).gt.0.999d0) go to 1670 >*/
  1108.     if (blank_1.value[tabinf_1.ifield + ifld - 1] > .999) {
  1109.     goto L1670;
  1110.     }
  1111. /*<       skw2=value(ifield+ifld) >*/
  1112.     ac_1.skw2 = blank_1.value[tabinf_1.ifield + ifld - 1];
  1113. /*<       ifld=ifld+1 >*/
  1114.     ++ifld;
  1115. /*<       if (nodplc(icode+ifld).ne.0) go to 6000 >*/
  1116.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1117.     goto L6000;
  1118.     }
  1119. /*<       if (value(ifield+ifld).lt.1.0d-10) go to 1670 >*/
  1120.     if (blank_1.value[tabinf_1.ifield + ifld - 1] < 1e-10) {
  1121.     goto L1670;
  1122.     }
  1123. /*<       refprl=value(ifield+ifld) >*/
  1124.     ac_1.refprl = blank_1.value[tabinf_1.ifield + ifld - 1];
  1125. /*<       ifld=ifld+1 >*/
  1126.     ++ifld;
  1127. /*<       if (nodplc(icode+ifld).ne.0) go to 6000 >*/
  1128.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1129.     goto L6000;
  1130.     }
  1131. /*<       if (value(ifield+ifld).lt.0.001d0) go to 1670 >*/
  1132.     if (blank_1.value[tabinf_1.ifield + ifld - 1] < .001) {
  1133.     goto L1670;
  1134.     }
  1135. /*<       spw2=value(ifield+ifld) >*/
  1136.     ac_1.spw2 = blank_1.value[tabinf_1.ifield + ifld - 1];
  1137. /*<       go to 6000 >*/
  1138.     goto L6000;
  1139. /*<  1660 write (iofile,1661) >*/
  1140. L1660:
  1141.     io__42.ciunit = status_1.iofile;
  1142.     s_wsfe(&io__42);
  1143.     e_wsfe();
  1144. /*<  1661 format('0warning:  distortion load resistor missing ... analysis ' >*/
  1145. /*<      1   ,'omitted'/) >*/
  1146. /*<       go to 6000 >*/
  1147.     goto L6000;
  1148. /*<  1670 idist=0 >*/
  1149. L1670:
  1150.     ac_1.idist = 0;
  1151. /*<       write (iofile,1671) >*/
  1152.     io__43.ciunit = status_1.iofile;
  1153.     s_wsfe(&io__43);
  1154.     e_wsfe();
  1155. /*<  1671 format('0warning:  distortion parameters incorrect ... analysis o' >*/
  1156. /*<      1   ,'mitted'/) >*/
  1157. /*<       go to 6000 >*/
  1158.     goto L6000;
  1159.  
  1160. /*  fourier analysis */
  1161.  
  1162. /*<  1700 ifld=2 >*/
  1163. L1700:
  1164.     ifld = 2;
  1165. /*<       if (nodplc(icode+ifld).ne.0) go to 1720 >*/
  1166.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1167.     goto L1720;
  1168.     }
  1169. /*<       if (value(ifield+ifld).le.0.0d0) go to 1720 >*/
  1170.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= 0.) {
  1171.     goto L1720;
  1172.     }
  1173. /*<       forfre=value(ifield+ifld) >*/
  1174.     tran_1.forfre = blank_1.value[tabinf_1.ifield + ifld - 1];
  1175. /*<  1705 ifld=ifld+1 >*/
  1176. L1705:
  1177.     ++ifld;
  1178. /*<       if (nodplc(icode+ifld).ne.1) go to 1710 >*/
  1179.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1180.     goto L1710;
  1181.     }
  1182. /*<       call outdef(ifld,2,loct,ltype) >*/
  1183.     outdef_(&ifld, &c__2, &loct, <ype);
  1184. /*<       if (igoof.ne.0) go to 1720 >*/
  1185.     if (flags_1.igoof != 0) {
  1186.     goto L1720;
  1187.     }
  1188. /*<       if (ltype.ne.1) go to 1720 >*/
  1189.     if (ltype != 1) {
  1190.     goto L1720;
  1191.     }
  1192. /*<       call extmem(ifour,1) >*/
  1193.     extmem_(&tabinf_1.ifour, &c__1);
  1194. /*<       nfour=nfour+1 >*/
  1195.     ++tabinf_1.nfour;
  1196. /*<       nodplc(ifour+nfour)=loct >*/
  1197.     nodplc[tabinf_1.ifour + tabinf_1.nfour - 1] = loct;
  1198. /*<       go to 1705 >*/
  1199.     goto L1705;
  1200. /*<  1710 if (nfour.ge.1) go to 6000 >*/
  1201. L1710:
  1202.     if (tabinf_1.nfour >= 1) {
  1203.     goto L6000;
  1204.     }
  1205. /*<  1720 write (iofile,1721) >*/
  1206. L1720:
  1207.     io__46.ciunit = status_1.iofile;
  1208.     s_wsfe(&io__46);
  1209.     e_wsfe();
  1210. /*<  1721 format('0warning:  fourier parameters incorrect ... analysis omit' >*/
  1211. /*<      1   ,'ted'/) >*/
  1212. /*<       igoof=0 >*/
  1213.     flags_1.igoof = 0;
  1214. /*<       nfour=0 >*/
  1215.     tabinf_1.nfour = 0;
  1216. /*<       call clrmem(ifour) >*/
  1217.     clrmem_(&tabinf_1.ifour);
  1218. /*<       call getm4(ifour,0) >*/
  1219.     getm4_(&tabinf_1.ifour, &c__0);
  1220. /*<       go to 6000 >*/
  1221.     goto L6000;
  1222.  
  1223. /*  sensitivity analysis */
  1224.  
  1225. /*<  1750 kssop=1 >*/
  1226. L1750:
  1227.     dc_1.kssop = 1;
  1228. /*<       ifld=1 >*/
  1229.     ifld = 1;
  1230. /*<  1760 ifld=ifld+1 >*/
  1231. L1760:
  1232.     ++ifld;
  1233. /*<       if (nodplc(icode+ifld).ne.1) go to 6000 >*/
  1234.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1235.     goto L6000;
  1236.     }
  1237. /*<       call outdef(ifld,1,loct,ltype) >*/
  1238.     outdef_(&ifld, &c__1, &loct, <ype);
  1239. /*<       if (igoof.ne.0) go to 1780 >*/
  1240.     if (flags_1.igoof != 0) {
  1241.     goto L1780;
  1242.     }
  1243. /*<       if (ltype.ne.1) go to 1780 >*/
  1244.     if (ltype != 1) {
  1245.     goto L1780;
  1246.     }
  1247. /*<       call extmem(isens,1) >*/
  1248.     extmem_(&tabinf_1.isens, &c__1);
  1249. /*<       nsens=nsens+1 >*/
  1250.     ++tabinf_1.nsens;
  1251. /*<       nodplc(isens+nsens)=loct >*/
  1252.     nodplc[tabinf_1.isens + tabinf_1.nsens - 1] = loct;
  1253. /*<       go to 1760 >*/
  1254.     goto L1760;
  1255. /*<  1780 write (iofile,1781) >*/
  1256. L1780:
  1257.     io__47.ciunit = status_1.iofile;
  1258.     s_wsfe(&io__47);
  1259.     e_wsfe();
  1260. /*<  1781 format('0warning:  output variable unrecognizable ... analysis om' >*/
  1261. /*<      1   ,'mitted'/) >*/
  1262. /*<       igoof=0 >*/
  1263.     flags_1.igoof = 0;
  1264. /*<       nsens=0 >*/
  1265.     tabinf_1.nsens = 0;
  1266. /*<       call clrmem(isens) >*/
  1267.     clrmem_(&tabinf_1.isens);
  1268. /*<       call getm4(isens,0) >*/
  1269.     getm4_(&tabinf_1.isens, &c__0);
  1270. /*<       go to 6000 >*/
  1271.     goto L6000;
  1272.  
  1273. /*  temperature variation */
  1274.  
  1275. /*<  1800 ifld=1 >*/
  1276. L1800:
  1277.     ifld = 1;
  1278. /*<  1810 ifld=ifld+1 >*/
  1279. L1810:
  1280.     ++ifld;
  1281. /*<       if (nodplc(icode+ifld).ne.0) go to 6000 >*/
  1282.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1283.     goto L6000;
  1284.     }
  1285. /*<       if (value(ifield+ifld).le.-223.0d0) go to 1810 >*/
  1286.     if (blank_1.value[tabinf_1.ifield + ifld - 1] <= -223.) {
  1287.     goto L1810;
  1288.     }
  1289. /*<       call extmem(itemps,1) >*/
  1290.     extmem_(&tabinf_1.itemps, &c__1);
  1291. /*<       numtem=numtem+1 >*/
  1292.     ++tabinf_1.numtem;
  1293. /*<       value(itemps+numtem)=value(ifield+ifld) >*/
  1294.     blank_1.value[tabinf_1.itemps + tabinf_1.numtem - 1] = blank_1.value[
  1295.         tabinf_1.ifield + ifld - 1];
  1296. /*<       go to 1810 >*/
  1297.     goto L1810;
  1298.  
  1299. /*  options card */
  1300.  
  1301. /*<  2000 ifld=1 >*/
  1302. L2000:
  1303.     ifld = 1;
  1304. /*<  2010 ifld=ifld+1 >*/
  1305. L2010:
  1306.     ++ifld;
  1307. /*<  2020 if (nodplc(icode+ifld)) 6000,2010,2030 >*/
  1308. L2020:
  1309.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1310.     goto L6000;
  1311.     } else if (i_1 == 0) {
  1312.     goto L2010;
  1313.     } else {
  1314.     goto L2030;
  1315.     }
  1316. /*<  2030 anam=value(ifield+ifld) >*/
  1317. L2030:
  1318.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1319. /*<       do 2040 i=1,5 >*/
  1320.     for (i = 1; i <= 5; ++i) {
  1321. /*<       if (anam.ne.aopts(i)) go to 2040 >*/
  1322.     if (anam != aopts[i - 1]) {
  1323.         goto L2040;
  1324.     }
  1325. /*<       iprnt(i)=lsetop(i) >*/
  1326.     iprnt[i - 1] = lsetop[i - 1];
  1327. /*<       ifld=ifld+1 >*/
  1328.     ++ifld;
  1329. /*<       if(nodplc(icode+ifld).ne.0) go to 2020 >*/
  1330.     if (nodplc[tabinf_1.icode + ifld - 1] != 0) {
  1331.         goto L2020;
  1332.     }
  1333. /*<       iprnt(i)=value(ifield+ifld) >*/
  1334.     iprnt[i - 1] = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  1335. /*<       go to 2010 >*/
  1336.     goto L2010;
  1337. /*<  2040 continue >*/
  1338. L2040:
  1339.     ;}
  1340. /*<       if (anam.eq.aopts(25)) go to 2110 >*/
  1341.     if (anam == aopts[24]) {
  1342.     goto L2110;
  1343.     }
  1344. /*<       if (anam.eq.aopts(26)) go to 2120 >*/
  1345.     if (anam == aopts[25]) {
  1346.     goto L2120;
  1347.     }
  1348. /*<       if (anam.eq.aopts(27)) go to 2130 >*/
  1349.     if (anam == aopts[26]) {
  1350.     goto L2130;
  1351.     }
  1352. /*<       if (anam.eq.aopts(28)) go to 2150 >*/
  1353.     if (anam == aopts[27]) {
  1354.     goto L2150;
  1355.     }
  1356. /*<       if (anam.eq.aopts(33)) go to 2200 >*/
  1357.     if (anam == aopts[32]) {
  1358.     goto L2200;
  1359.     }
  1360. /*<       if (anam.eq.aopts(34)) go to 2250 >*/
  1361.     if (anam == aopts[33]) {
  1362.     goto L2250;
  1363.     }
  1364. /*<       if (nodplc(icode+ifld+1).ne.0) go to 2510 >*/
  1365.     if (nodplc[tabinf_1.icode + ifld] != 0) {
  1366.     goto L2510;
  1367.     }
  1368. /*<       ifld=ifld+1 >*/
  1369.     ++ifld;
  1370. /*<       aval=value(ifield+ifld) >*/
  1371.     aval = blank_1.value[tabinf_1.ifield + ifld - 1];
  1372. /*<       do 2050 i=6,11 >*/
  1373.     for (i = 6; i <= 11; ++i) {
  1374. /*<       if (anam.ne.aopts(i)) go to 2050 >*/
  1375.     if (anam != aopts[i - 1]) {
  1376.         goto L2050;
  1377.     }
  1378. /*<       if(aval.le.0.0d0.and.i.ne.10) go to 2510 >*/
  1379.     if (aval <= 0. && i != 10) {
  1380.         goto L2510;
  1381.     }
  1382. /*<       itrlim(i-5)=aval >*/
  1383.     itrlim[i - 6] = (integer) aval;
  1384. /*<       go to 2010 >*/
  1385.     goto L2010;
  1386. /*<  2050 continue >*/
  1387. L2050:
  1388.     ;}
  1389. /*<       if (aval.le.0.0d0) go to 2510 >*/
  1390.     if (aval <= 0.) {
  1391.     goto L2510;
  1392.     }
  1393. /*<       do 2060 i=12,15 >*/
  1394.     for (i = 12; i <= 15; ++i) {
  1395. /*<       if (anam.ne.aopts(i)) go to 2060 >*/
  1396.     if (anam != aopts[i - 1]) {
  1397.         goto L2060;
  1398.     }
  1399. /*<       limits(i-11)=aval >*/
  1400.     limits[i - 12] = (integer) aval;
  1401. /*<       go to 2010 >*/
  1402.     goto L2010;
  1403. /*<  2060 continue >*/
  1404. L2060:
  1405.     ;}
  1406. /*<       do 2070 i=16,21 >*/
  1407.     for (i = 16; i <= 21; ++i) {
  1408. /*<       if (anam.ne.aopts(i)) go to 2070 >*/
  1409.     if (anam != aopts[i - 1]) {
  1410.         goto L2070;
  1411.     }
  1412. /*<       contol(i-15)=aval >*/
  1413.     contol[i - 16] = aval;
  1414. /*<       go to 2010 >*/
  1415.     goto L2010;
  1416. /*<  2070 continue >*/
  1417. L2070:
  1418.     ;}
  1419. /*<       do 2075 i=29,32 >*/
  1420.     for (i = 29; i <= 32; ++i) {
  1421. /*<       if(anam.ne.aopts(i)) go to 2075 >*/
  1422.     if (anam != aopts[i - 1]) {
  1423.         goto L2075;
  1424.     }
  1425. /*<       dflts(i-28)=aval >*/
  1426.     dflts[i - 29] = aval;
  1427. /*<       go to 2010 >*/
  1428.     goto L2010;
  1429. /*<  2075 continue >*/
  1430. L2075:
  1431.     ;}
  1432. /*<       if (anam.ne.aopts(22)) go to 2080 >*/
  1433.     if (anam != aopts[21]) {
  1434.     goto L2080;
  1435.     }
  1436. /*<       if (aval.lt.-223.0d0) go to 2510 >*/
  1437.     if (aval < -223.) {
  1438.     goto L2510;
  1439.     }
  1440. /*<       value(itemps+1)=aval >*/
  1441.     blank_1.value[tabinf_1.itemps] = aval;
  1442. /*<       go to 2010 >*/
  1443.     goto L2010;
  1444. /*<  2080 if (anam.ne.aopts(23)) go to 2100 >*/
  1445. L2080:
  1446.     if (anam != aopts[22]) {
  1447.     goto L2100;
  1448.     }
  1449. /*<       ndigit=aval >*/
  1450.     ndigit = (integer) aval;
  1451. /*<       if (ndigit.le.7) go to 2090 >*/
  1452.     if (ndigit <= 7) {
  1453.     goto L2090;
  1454.     }
  1455. /*<       ndigit=7 >*/
  1456.     ndigit = 7;
  1457. /*<       write (iofile,2081) ndigit >*/
  1458.     io__51.ciunit = status_1.iofile;
  1459.     s_wsfe(&io__51);
  1460.     do_fio(&c__1, (char *)&ndigit, (ftnlen)sizeof(integer));
  1461.     e_wsfe();
  1462. /*<  2081 format('0warning:  numdgt may not exceed',i2, >*/
  1463. /*<      1 ';  maximum value assumed'/) >*/
  1464. /*<  2090 numdgt=ndigit >*/
  1465. L2090:
  1466.     outinf_1.numdgt = ndigit;
  1467. /*<       go to 2010 >*/
  1468.     goto L2010;
  1469. /*<  2100 if (anam.ne.aopts(24)) go to 2500 >*/
  1470. L2100:
  1471.     if (anam != aopts[23]) {
  1472.     goto L2500;
  1473.     }
  1474. /*<       n=aval >*/
  1475.     n = (integer) aval;
  1476. /*<       if ((n.le.1).or.(n.ge.7)) go to 2510 >*/
  1477.     if (n <= 1 || n >= 7) {
  1478.     goto L2510;
  1479.     }
  1480. /*<       maxord=n >*/
  1481.     status_1.maxord = n;
  1482. /*<       go to 2010 >*/
  1483.     goto L2010;
  1484. /*<  2110 if (nodplc(icode+ifld+1).ne.1) go to 2510 >*/
  1485. L2110:
  1486.     if (nodplc[tabinf_1.icode + ifld] != 1) {
  1487.     goto L2510;
  1488.     }
  1489. /*<       ifld=ifld+1 >*/
  1490.     ++ifld;
  1491. /*<       anam=value(ifield+ifld) >*/
  1492.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1493. /*<       call move(anam,5,ablnk,1,4) >*/
  1494.     move_(&anam, &c__5, &ablnk, &c__1, &c__4);
  1495. /*<       jtype=0 >*/
  1496.     jtype = 0;
  1497. /*<       if (anam.eq.atrap) jtype=1 >*/
  1498.     if (anam == atrap) {
  1499.     jtype = 1;
  1500.     }
  1501. /*<       if (anam.eq.agear) jtype=2 >*/
  1502.     if (anam == agear) {
  1503.     jtype = 2;
  1504.     }
  1505. /*<       if (jtype.eq.0) go to 2510 >*/
  1506.     if (jtype == 0) {
  1507.     goto L2510;
  1508.     }
  1509. /*<       method=jtype >*/
  1510.     status_1.method = jtype;
  1511. /*<       go to 2010 >*/
  1512.     goto L2010;
  1513. /*<  2120 nopage=1 >*/
  1514. L2120:
  1515.     miscel_1.nopage = 1;
  1516. /*<       go to 2010 >*/
  1517.     goto L2010;
  1518. /*<  2130 ifld=ifld+1 >*/
  1519. L2130:
  1520.     ++ifld;
  1521. /*<       if(nodplc(icode+ifld)) 6000,2140,2030 >*/
  1522.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1523.     goto L6000;
  1524.     } else if (i_1 == 0) {
  1525.     goto L2140;
  1526.     } else {
  1527.     goto L2030;
  1528.     }
  1529. /*<  2140 aval=value(ifield+ifld) >*/
  1530. L2140:
  1531.     aval = blank_1.value[tabinf_1.ifield + ifld - 1];
  1532. /*<       if(aval.lt.0.0d0.or.aval.gt.0.500001d0) go to 2510 >*/
  1533.     if (aval < 0. || aval > .500001) {
  1534.     goto L2510;
  1535.     }
  1536. /*<       xmu=aval >*/
  1537.     status_1.xmu = aval;
  1538. /*<       go to 2010 >*/
  1539.     goto L2010;
  1540. /*<  2150 ifld=ifld+1 >*/
  1541. L2150:
  1542.     ++ifld;
  1543. /*<       if(nodplc(icode+ifld)) 6000,2160,2030 >*/
  1544.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1545.     goto L6000;
  1546.     } else if (i_1 == 0) {
  1547.     goto L2160;
  1548.     } else {
  1549.     goto L2030;
  1550.     }
  1551. /*<  2160 aval=value(ifield+ifld) >*/
  1552. L2160:
  1553.     aval = blank_1.value[tabinf_1.ifield + ifld - 1];
  1554. /*<       maxtim=aval >*/
  1555.     cje_1.maxtim = (integer) aval;
  1556. /*<       go to 2010 >*/
  1557.     goto L2010;
  1558. /*<  2200 ifld=ifld+1 >*/
  1559. L2200:
  1560.     ++ifld;
  1561. /*<       if (nodplc(icode+ifld)) 6000,2210,2030 >*/
  1562.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1563.     goto L6000;
  1564.     } else if (i_1 == 0) {
  1565.     goto L2210;
  1566.     } else {
  1567.     goto L2030;
  1568.     }
  1569. /*<  2210 aval=value(ifield+ifld) >*/
  1570. L2210:
  1571.     aval = blank_1.value[tabinf_1.ifield + ifld - 1];
  1572. /*<       if (aval.gt.1.0d0) go to 2510 >*/
  1573.     if (aval > 1.) {
  1574.     goto L2510;
  1575.     }
  1576. /*<       pivtol=aval >*/
  1577.     knstnt_1.pivtol = aval;
  1578. /*<       go to 2010 >*/
  1579.     goto L2010;
  1580. /*<  2250 ifld=ifld+1 >*/
  1581. L2250:
  1582.     ++ifld;
  1583. /*<       if (nodplc(icode+ifld)) 6000,2260,2030 >*/
  1584.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1585.     goto L6000;
  1586.     } else if (i_1 == 0) {
  1587.     goto L2260;
  1588.     } else {
  1589.     goto L2030;
  1590.     }
  1591. /*<  2260 aval=value(ifield+ifld) >*/
  1592. L2260:
  1593.     aval = blank_1.value[tabinf_1.ifield + ifld - 1];
  1594. /*<       if (aval.gt.1.0d0) go to 2510 >*/
  1595.     if (aval > 1.) {
  1596.     goto L2510;
  1597.     }
  1598. /*<       pivrel=aval >*/
  1599.     knstnt_1.pivrel = aval;
  1600. /*<       go to 2010 >*/
  1601.     goto L2010;
  1602. /*<  2500 write (iofile,2501) anam >*/
  1603. L2500:
  1604.     io__54.ciunit = status_1.iofile;
  1605.     s_wsfe(&io__54);
  1606.     do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
  1607.     e_wsfe();
  1608. /*<  2501 format('0warning:  unknown option:  ',a8,' ... ignored'/) >*/
  1609. /*<       go to 2010 >*/
  1610.     goto L2010;
  1611. /*<  2510 write (iofile,2511) anam >*/
  1612. L2510:
  1613.     io__55.ciunit = status_1.iofile;
  1614.     s_wsfe(&io__55);
  1615.     do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
  1616.     e_wsfe();
  1617. /*<  2511 format('0warning:  illegal value specified for option:  ',a8,' ... >*/
  1618. /*<      1 ignored'/) >*/
  1619. /*<       go to 2010 >*/
  1620.     goto L2010;
  1621.  
  1622. /*  print card */
  1623.  
  1624. /*<  3500 iprpl=0 >*/
  1625. L3500:
  1626.     iprpl = 0;
  1627. /*<       go to 3610 >*/
  1628.     goto L3610;
  1629.  
  1630. /*  plot (and print) card */
  1631.  
  1632. /*<  3600 iprpl=1 >*/
  1633. L3600:
  1634.     iprpl = 1;
  1635. /*<  3610 ifld=2 >*/
  1636. L3610:
  1637.     ifld = 2;
  1638. /*<  3613 anam=amiss >*/
  1639. /* L3613: */
  1640.     anam = amiss;
  1641. /*<       if (nodplc(icode+ifld).ne.1) go to 3950 >*/
  1642.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1643.     goto L3950;
  1644.     }
  1645. /*<       anam=value(ifield+ifld) >*/
  1646.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1647. /*<       ms=0 >*/
  1648.     ms = 0;
  1649. /*<       if (xxor(anam,ams).ne.0) go to 3615 >*/
  1650.     if (xxor_(&anam, &ams) != 0) {
  1651.     goto L3615;
  1652.     }
  1653. /*<       ms=1 >*/
  1654.     ms = 1;
  1655. /*<       ifld=3 >*/
  1656.     ifld = 3;
  1657. /*<       if (nodplc(icode+ifld).ne.1) go to 3970 >*/
  1658.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1659.     goto L3970;
  1660.     }
  1661. /*<       anam=value(ifield+ifld) >*/
  1662.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1663. /*<  3615 call move(anam,3,ablnk,1,6) >*/
  1664. L3615:
  1665.     move_(&anam, &c__3, &ablnk, &c__1, &c__6);
  1666. /*<       do 3620 i=1,5 >*/
  1667.     for (i = 1; i <= 5; ++i) {
  1668. /*<       if (anam.ne.aopt(i)) go to 3620 >*/
  1669.     if (anam != aopt[i - 1]) {
  1670.         goto L3620;
  1671.     }
  1672. /*<       ktype=i >*/
  1673.     ktype = i;
  1674. /*<       go to 3630 >*/
  1675.     goto L3630;
  1676. /*<  3620 continue >*/
  1677. L3620:
  1678.     ;}
  1679. /*<       go to 3950 >*/
  1680.     goto L3950;
  1681. /*<  3630 id=30+5*iprpl+ktype >*/
  1682. L3630:
  1683.     *id = iprpl * 5 + 30 + ktype;
  1684. /*<       call find(dble(jelcnt(id)),id,loc,1) >*/
  1685.     d_1 = (doublereal) cirdat_1.jelcnt[*id - 1];
  1686.     find_(&d_1, id, &loc, &c__1);
  1687. /*<       nodplc(loc+2)=ktype >*/
  1688.     nodplc[loc + 1] = ktype;
  1689. /*<       if (ms.eq.0) go to 3635 >*/
  1690.     if (ms == 0) {
  1691.     goto L3635;
  1692.     }
  1693. /*<       locv=nodplc(loc+1) >*/
  1694.     locv = nodplc[loc];
  1695. /*<       value(locv)=0.0d0 >*/
  1696.     blank_1.value[locv - 1] = 0.;
  1697. /*<  3635 numout=0 >*/
  1698. L3635:
  1699.     outinf_1.numout = 0;
  1700. /*<  3640 ifld=ifld+1 >*/
  1701. L3640:
  1702.     ++ifld;
  1703. /*<       if (nodplc(icode+ifld)) 3900,3640,3650 >*/
  1704.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1705.     goto L3900;
  1706.     } else if (i_1 == 0) {
  1707.     goto L3640;
  1708.     } else {
  1709.     goto L3650;
  1710.     }
  1711. /*<  3650 call outdef(ifld,ktype,loct,ltype) >*/
  1712. L3650:
  1713.     outdef_(&ifld, &ktype, &loct, <ype);
  1714. /*<       if (igoof.ne.0) go to 3970 >*/
  1715.     if (flags_1.igoof != 0) {
  1716.     goto L3970;
  1717.     }
  1718. /*<       if (iprpl.eq.0) go to 3660 >*/
  1719.     if (iprpl == 0) {
  1720.     goto L3660;
  1721.     }
  1722. /*<       plimlo=0.0d0 >*/
  1723.     plimlo = 0.;
  1724. /*<       plimhi=0.0d0 >*/
  1725.     plimhi = 0.;
  1726. /*<       if (nodplc(icode+ifld+1).ne.0) go to 3660 >*/
  1727.     if (nodplc[tabinf_1.icode + ifld] != 0) {
  1728.     goto L3660;
  1729.     }
  1730. /*<       if (nodplc(icode+ifld+2).ne.0) go to 3660 >*/
  1731.     if (nodplc[tabinf_1.icode + ifld + 1] != 0) {
  1732.     goto L3660;
  1733.     }
  1734. /*<       plimlo=value(ifield+ifld+1) >*/
  1735.     plimlo = blank_1.value[tabinf_1.ifield + ifld];
  1736. /*<       plimhi=value(ifield+ifld+2) >*/
  1737.     plimhi = blank_1.value[tabinf_1.ifield + ifld + 1];
  1738. /*<       ifld=ifld+2 >*/
  1739.     ifld += 2;
  1740. /*<  3660 numout=numout+1 >*/
  1741. L3660:
  1742.     ++outinf_1.numout;
  1743. /*<       lspot=loc+2*numout+2 >*/
  1744.     lspot = loc + (outinf_1.numout << 1) + 2;
  1745. /*<       nodplc(lspot)=loct >*/
  1746.     nodplc[lspot - 1] = loct;
  1747. /*<       nodplc(lspot+1)=ltype >*/
  1748.     nodplc[lspot] = ltype;
  1749. /*<       if (iprpl.eq.0) go to 3670 >*/
  1750.     if (iprpl == 0) {
  1751.     goto L3670;
  1752.     }
  1753. /*<       locv=nodplc(loc+1) >*/
  1754.     locv = nodplc[loc];
  1755. /*<       lspot=locv+2*numout-1 >*/
  1756.     lspot = locv + (outinf_1.numout << 1) - 1;
  1757. /*<       value(lspot)=plimlo >*/
  1758.     blank_1.value[lspot - 1] = plimlo;
  1759. /*<       value(lspot+1)=plimhi >*/
  1760.     blank_1.value[lspot] = plimhi;
  1761. /*<  3670 if (numout.eq.8) go to 3900 >*/
  1762. L3670:
  1763.     if (outinf_1.numout == 8) {
  1764.     goto L3900;
  1765.     }
  1766. /*<       go to 3640 >*/
  1767.     goto L3640;
  1768. /*<  3900 nodplc(loc+3)=numout >*/
  1769. L3900:
  1770.     nodplc[loc + 2] = outinf_1.numout;
  1771. /*<       if (iprpl.eq.0) go to 6000 >*/
  1772.     if (iprpl == 0) {
  1773.     goto L6000;
  1774.     }
  1775. /* ...  propogate plot limits downward */
  1776. /*<       if (numout.le.1) go to 6000 >*/
  1777.     if (outinf_1.numout <= 1) {
  1778.     goto L6000;
  1779.     }
  1780. /*<       locv=nodplc(loc+1) >*/
  1781.     locv = nodplc[loc];
  1782. /*<       lspot=locv+2*numout-1 >*/
  1783.     lspot = locv + (outinf_1.numout << 1) - 1;
  1784. /*<       plimlo=value(lspot) >*/
  1785.     plimlo = blank_1.value[lspot - 1];
  1786. /*<       plimhi=value(lspot+1) >*/
  1787.     plimhi = blank_1.value[lspot];
  1788. /*<       i=numout-1 >*/
  1789.     i = outinf_1.numout - 1;
  1790. /*<  3905 lspot=lspot-2 >*/
  1791. L3905:
  1792.     lspot += -2;
  1793. /*<       if (value(lspot).ne.0.0d0) go to 3910 >*/
  1794.     if (blank_1.value[lspot - 1] != 0.) {
  1795.     goto L3910;
  1796.     }
  1797. /*<       if (value(lspot+1).ne.0.0d0) go to 3910 >*/
  1798.     if (blank_1.value[lspot] != 0.) {
  1799.     goto L3910;
  1800.     }
  1801. /*<       value(lspot)=plimlo >*/
  1802.     blank_1.value[lspot - 1] = plimlo;
  1803. /*<       value(lspot+1)=plimhi >*/
  1804.     blank_1.value[lspot] = plimhi;
  1805. /*<       go to 3920 >*/
  1806.     goto L3920;
  1807. /*<  3910 plimlo=value(lspot) >*/
  1808. L3910:
  1809.     plimlo = blank_1.value[lspot - 1];
  1810. /*<       plimhi=value(lspot+1) >*/
  1811.     plimhi = blank_1.value[lspot];
  1812. /*<  3920 i=i-1 >*/
  1813. L3920:
  1814.     --i;
  1815. /*<       if (i.ge.1) go to 3905 >*/
  1816.     if (i >= 1) {
  1817.     goto L3905;
  1818.     }
  1819. /*<       go to 6000 >*/
  1820.     goto L6000;
  1821.  
  1822. /*     errors */
  1823.  
  1824. /*<  3950 write (iofile,3951) anam >*/
  1825. L3950:
  1826.     io__63.ciunit = status_1.iofile;
  1827.     s_wsfe(&io__63);
  1828.     do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
  1829.     e_wsfe();
  1830. /*<  3951 format('0warning:  unknown analysis mode:  ',a8, >*/
  1831. /*<      1  ' ... line ignored'/) >*/
  1832. /*<       go to 6000 >*/
  1833.     goto L6000;
  1834. /*<  3970 write (iofile,3971) >*/
  1835. L3970:
  1836.     io__64.ciunit = status_1.iofile;
  1837.     s_wsfe(&io__64);
  1838.     e_wsfe();
  1839. /*<  3971 format('0warning:  unrecognizable output variable on above line'/) >*/
  1840. /*<       igoof=0 >*/
  1841.     flags_1.igoof = 0;
  1842. /*<       go to 3640 >*/
  1843.     goto L3640;
  1844.  
  1845. /*  width card */
  1846.  
  1847. /*<  4000 ifld=1 >*/
  1848. L4000:
  1849.     ifld = 1;
  1850. /*<  4010 ifld=ifld+1 >*/
  1851. L4010:
  1852.     ++ifld;
  1853. /*<       if (nodplc(icode+ifld).ne.1) go to 6000 >*/
  1854.     if (nodplc[tabinf_1.icode + ifld - 1] != 1) {
  1855.     goto L6000;
  1856.     }
  1857. /*<  4020 anam=value(ifield+ifld) >*/
  1858. L4020:
  1859.     anam = blank_1.value[tabinf_1.ifield + ifld - 1];
  1860. /*<       if (anam.ne.ain) go to 4040 >*/
  1861.     if (anam != ain) {
  1862.     goto L4040;
  1863.     }
  1864. /*<       ifld=ifld+1 >*/
  1865.     ++ifld;
  1866. /*<       if (nodplc(icode+ifld)) 6000,4030,4020 >*/
  1867.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1868.     goto L6000;
  1869.     } else if (i_1 == 0) {
  1870.     goto L4030;
  1871.     } else {
  1872.     goto L4020;
  1873.     }
  1874. /*<  4030 iwidth=value(ifield+ifld) >*/
  1875. L4030:
  1876.     miscel_1.iwidth = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  1877. /*<       iwidth=min0(max0(iwidth,10),120) >*/
  1878. /* Computing MAX */
  1879.     i_1 = max(miscel_1.iwidth,10);
  1880.     miscel_1.iwidth = min(120,i_1);
  1881. /*<       go to 4010 >*/
  1882.     goto L4010;
  1883. /*<  4040 if (anam.ne.aout) go to 6000 >*/
  1884. L4040:
  1885.     if (anam != aout) {
  1886.     goto L6000;
  1887.     }
  1888. /*<       ifld=ifld+1 >*/
  1889.     ++ifld;
  1890. /*<       if (nodplc(icode+ifld)) 6000,4050,4020 >*/
  1891.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1892.     goto L6000;
  1893.     } else if (i_1 == 0) {
  1894.     goto L4050;
  1895.     } else {
  1896.     goto L4020;
  1897.     }
  1898. /*<  4050 lwidth=dmin1(dmax1(value(ifield+ifld),72.0d0),132.0d0) >*/
  1899. L4050:
  1900. /* Computing MAX */
  1901. /* Computing MAX */
  1902.     d_2 = blank_1.value[tabinf_1.ifield + ifld - 1];
  1903.     d_1 = max(72.,d_2);
  1904.     miscel_1.lwidth = (integer) min(132.,d_1);
  1905. /*<       go to 4010 >*/
  1906.     goto L4010;
  1907.  
  1908. /*  nodeset statement */
  1909.  
  1910. /*<  4100 ifld=1 >*/
  1911. L4100:
  1912.     ifld = 1;
  1913. /*<  4110 ifld=ifld+1 >*/
  1914. L4110:
  1915.     ++ifld;
  1916. /*<       if(nodplc(icode+ifld)) 6000,4120,4110 >*/
  1917.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1918.     goto L6000;
  1919.     } else if (i_1 == 0) {
  1920.     goto L4120;
  1921.     } else {
  1922.     goto L4110;
  1923.     }
  1924. /*<  4120 nodnum=value(ifield+ifld) >*/
  1925. L4120:
  1926.     nodnum = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  1927. /*<       if(nodnum.le.0) go to 4190 >*/
  1928.     if (nodnum <= 0) {
  1929.     goto L4190;
  1930.     }
  1931. /*<       ifld=ifld+1 >*/
  1932.     ++ifld;
  1933. /*<       if(nodplc(icode+ifld)) 4180,4130,4170 >*/
  1934.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1935.     goto L4180;
  1936.     } else if (i_1 == 0) {
  1937.     goto L4130;
  1938.     } else {
  1939.     goto L4170;
  1940.     }
  1941. /*<  4130 call sizmem(nsnod,nic) >*/
  1942. L4130:
  1943.     sizmem_(&tabinf_1.nsnod, &nic);
  1944. /*<       call extmem(nsnod,1) >*/
  1945.     extmem_(&tabinf_1.nsnod, &c__1);
  1946. /*<       call extmem(nsval,1) >*/
  1947.     extmem_(&tabinf_1.nsval, &c__1);
  1948. /*<       nodplc(nsnod+nic+1)=nodnum >*/
  1949.     nodplc[tabinf_1.nsnod + nic] = nodnum;
  1950. /*<       value(nsval+nic+1)=value(ifield+ifld) >*/
  1951.     blank_1.value[tabinf_1.nsval + nic] = blank_1.value[tabinf_1.ifield + 
  1952.         ifld - 1];
  1953. /*<       go to 4110 >*/
  1954.     goto L4110;
  1955.  
  1956. /*  errors on .nodeset statement */
  1957.  
  1958. /*<  4170 write(iofile,4171) value(ifield+ifld) >*/
  1959. L4170:
  1960.     io__67.ciunit = status_1.iofile;
  1961.     s_wsfe(&io__67);
  1962.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.ifield + ifld - 1], (ftnlen)
  1963.         sizeof(doublereal));
  1964.     e_wsfe();
  1965. /*<  4171 format('0warning: out-of-place non-numeric field ',a8, >*/
  1966. /*<      1 ' skipped'/) >*/
  1967. /*<       go to 4110 >*/
  1968.     goto L4110;
  1969. /*<  4180 write(iofile,4181) nodnum >*/
  1970. L4180:
  1971.     io__68.ciunit = status_1.iofile;
  1972.     s_wsfe(&io__68);
  1973.     do_fio(&c__1, (char *)&nodnum, (ftnlen)sizeof(integer));
  1974.     e_wsfe();
  1975. /*<  4181 format('0warning: initial value missing for node ',i5,/) >*/
  1976. /*<       go to 6000 >*/
  1977.     goto L6000;
  1978. /*<  4190 write(iofile,4191) >*/
  1979. L4190:
  1980.     io__69.ciunit = status_1.iofile;
  1981.     s_wsfe(&io__69);
  1982.     e_wsfe();
  1983. /*<  4191 format('0warning: attempt to specify initial condition for ', >*/
  1984. /*<      1 'ground ingnored',/) >*/
  1985. /*<       ifld=ifld+1 >*/
  1986.     ++ifld;
  1987. /*<       if(nodplc(icode+ifld)) 6000,4110,4170 >*/
  1988.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  1989.     goto L6000;
  1990.     } else if (i_1 == 0) {
  1991.     goto L4110;
  1992.     } else {
  1993.     goto L4170;
  1994.     }
  1995.  
  1996. /*  initial conditions statement */
  1997.  
  1998. /*<  4200 ifld=1 >*/
  1999. L4200:
  2000.     ifld = 1;
  2001. /*<  4210 ifld=ifld+1 >*/
  2002. L4210:
  2003.     ++ifld;
  2004. /*<       if(nodplc(icode+ifld)) 6000,4220,4210 >*/
  2005.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  2006.     goto L6000;
  2007.     } else if (i_1 == 0) {
  2008.     goto L4220;
  2009.     } else {
  2010.     goto L4210;
  2011.     }
  2012. /*<  4220 nodnum=value(ifield+ifld) >*/
  2013. L4220:
  2014.     nodnum = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  2015. /*<       if(nodnum.le.0) go to 4290 >*/
  2016.     if (nodnum <= 0) {
  2017.     goto L4290;
  2018.     }
  2019. /*<       ifld=ifld+1 >*/
  2020.     ++ifld;
  2021. /*<       if(nodplc(icode+ifld)) 4280,4230,4270 >*/
  2022.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  2023.     goto L4280;
  2024.     } else if (i_1 == 0) {
  2025.     goto L4230;
  2026.     } else {
  2027.     goto L4270;
  2028.     }
  2029. /*<  4230 call sizmem(icnod,nic) >*/
  2030. L4230:
  2031.     sizmem_(&tabinf_1.icnod, &nic);
  2032. /*<       call extmem(icnod,1) >*/
  2033.     extmem_(&tabinf_1.icnod, &c__1);
  2034. /*<       call extmem(icval,1) >*/
  2035.     extmem_(&tabinf_1.icval, &c__1);
  2036. /*<       nodplc(icnod+nic+1)=nodnum >*/
  2037.     nodplc[tabinf_1.icnod + nic] = nodnum;
  2038. /*<       value(icval+nic+1)=value(ifield+ifld) >*/
  2039.     blank_1.value[tabinf_1.icval + nic] = blank_1.value[tabinf_1.ifield + 
  2040.         ifld - 1];
  2041. /*<       go to 4210 >*/
  2042.     goto L4210;
  2043.  
  2044. /*  errors on .ic statement */
  2045.  
  2046. /*<  4270 write(iofile,4271) value(ifield+ifld) >*/
  2047. L4270:
  2048.     io__70.ciunit = status_1.iofile;
  2049.     s_wsfe(&io__70);
  2050.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.ifield + ifld - 1], (ftnlen)
  2051.         sizeof(doublereal));
  2052.     e_wsfe();
  2053. /*<  4271 format('0warning: out-of-place non-numeric field ',a8, >*/
  2054. /*<      1 ' skipped'/) >*/
  2055. /*<       go to 4210 >*/
  2056.     goto L4210;
  2057. /*<  4280 write(iofile,4281) nodnum >*/
  2058. L4280:
  2059.     io__71.ciunit = status_1.iofile;
  2060.     s_wsfe(&io__71);
  2061.     do_fio(&c__1, (char *)&nodnum, (ftnlen)sizeof(integer));
  2062.     e_wsfe();
  2063. /*<  4281 format('0warning: initial value missing for node ',i5,/) >*/
  2064. /*<       go to 6000 >*/
  2065.     goto L6000;
  2066. /*<  4290 write(iofile,4291) >*/
  2067. L4290:
  2068.     io__72.ciunit = status_1.iofile;
  2069.     s_wsfe(&io__72);
  2070.     e_wsfe();
  2071. /*<  4291 format('0warning: attempt to specify initial condition for ', >*/
  2072. /*<      1 'ground ignored',/) >*/
  2073. /*<       ifld=ifld+1 >*/
  2074.     ++ifld;
  2075. /*<       if(nodplc(icode+ifld)) 6000,4210,4270 >*/
  2076.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  2077.     goto L6000;
  2078.     } else if (i_1 == 0) {
  2079.     goto L4210;
  2080.     } else {
  2081.     goto L4270;
  2082.     }
  2083.  
  2084. /*     :debug: statement */
  2085. /*     sample debug line: .:debug: 5=3 17=5 */
  2086.  
  2087. /*<  5900 ifld=1 >*/
  2088. L5900:
  2089.     ifld = 1;
  2090. /*<  5910 ifld=ifld+1 >*/
  2091. L5910:
  2092.     ++ifld;
  2093. /*<       if (nodplc(icode+ifld)) 6000,5920,5910 >*/
  2094.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  2095.     goto L6000;
  2096.     } else if (i_1 == 0) {
  2097.     goto L5920;
  2098.     } else {
  2099.     goto L5910;
  2100.     }
  2101. /*<  5920 index=value(ifield+ifld) >*/
  2102. L5920:
  2103.     index = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  2104. /*<       ifld=ifld+1 >*/
  2105.     ++ifld;
  2106. /*<       if (nodplc(icode+ifld)) 6000,5930,5910 >*/
  2107.     if ((i_1 = nodplc[tabinf_1.icode + ifld - 1]) < 0) {
  2108.     goto L6000;
  2109.     } else if (i_1 == 0) {
  2110.     goto L5930;
  2111.     } else {
  2112.     goto L5910;
  2113.     }
  2114. /*<  5930 ival=value(ifield+ifld) >*/
  2115. L5930:
  2116.     ival = (integer) blank_1.value[tabinf_1.ifield + ifld - 1];
  2117. /*<       if (index.lt.1) go to 5910 >*/
  2118.     if (index < 1) {
  2119.     goto L5910;
  2120.     }
  2121. /*<       if (index.gt.20) go to 5910 >*/
  2122.     if (index > 20) {
  2123.     goto L5910;
  2124.     }
  2125. /*<       write(iofile,5931) index,ival >*/
  2126.     io__75.ciunit = status_1.iofile;
  2127.     s_wsfe(&io__75);
  2128.     do_fio(&c__1, (char *)&index, (ftnlen)sizeof(integer));
  2129.     do_fio(&c__1, (char *)&ival, (ftnlen)sizeof(integer));
  2130.     e_wsfe();
  2131. /*<  5931 format(' *debug*:  runcon - idebug(',i2,') set to ',i10) >*/
  2132. /*<       idebug(index)=ival >*/
  2133.     debug_1.idebug[index - 1] = ival;
  2134. /*<       go to 5910 >*/
  2135.     goto L5910;
  2136.  
  2137. /*  finished */
  2138.  
  2139. /*<  6000 return >*/
  2140. L6000:
  2141.     return 0;
  2142. /*<       end >*/
  2143. } /* runcon_ */
  2144.  
  2145. #undef contol
  2146. #undef itrlim
  2147. #undef limits
  2148. #undef cvalue
  2149. #undef nodplc
  2150. #undef iprnt
  2151. #undef dflts
  2152. #undef aopts
  2153. #undef aopt
  2154. #undef ams
  2155. #undef amiss
  2156. #undef aout
  2157. #undef ain
  2158. #undef ablnk
  2159. #undef auic
  2160. #undef agear
  2161. #undef atrap
  2162. #undef alsli
  2163. #undef alsoc
  2164. #undef alsde
  2165. #undef aide
  2166.  
  2167.  
  2168.